Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/ivbsrc/access.frm

Text File | 1995-05-08 | 7KB | 238 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "Form1"
   ClientHeight    =   3480
   ClientLeft      =   90
   ClientTop       =   1350
   ClientWidth     =   4995
   Height          =   3885
   Left            =   30
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   3480
   ScaleWidth      =   4995
   Top             =   1005
   Width           =   5115
   Begin CommandButton Command0
      Caption         =   "Create a test file on disk C:"
      Height          =   375
      Left            =   120
      TabIndex        =   7
      Top             =   3000
      Width           =   3375
   End
   Begin CommandButton Command6
      Caption         =   "Quit"
      Height          =   855
      Left            =   3600
      TabIndex        =   4
      Top             =   2520
      Width           =   1335
   End
   Begin CommandButton Command5
      Caption         =   "Clear array"
      Height          =   375
      Left            =   3600
      TabIndex        =   3
      Top             =   2040
      Width           =   1335
   End
   Begin CommandButton Command4
      Caption         =   "Clear list box"
      Height          =   375
      Left            =   3600
      TabIndex        =   6
      Top             =   1560
      Width           =   1335
   End
   Begin CommandButton Command3
      Caption         =   "Rewrite array"
      Height          =   375
      Left            =   3600
      TabIndex        =   5
      Top             =   1080
      Width           =   1335
   End
   Begin CommandButton Command2
      Caption         =   "Load list box"
      Height          =   375
      Left            =   3600
      TabIndex        =   2
      Top             =   600
      Width           =   1335
   End
   Begin CommandButton Command1
      Caption         =   "Create array"
      Height          =   375
      Left            =   3600
      TabIndex        =   1
      Top             =   120
      Width           =   1335
   End
   Begin ListBox List1
      Height          =   2760
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   3375
   End
End
Declare Function hread Lib "kernel" Alias "_hread" (ByVal hFile%, ByVal memAddr&, ByVal dwBytes&) As Long

Declare Function lclose Lib "Kernel" Alias "_lclose" (ByVal hFile As Integer) As Integer
Declare Function llseek Lib "Kernel" Alias "_llseek" (ByVal hFile As Integer, ByVal lOffset As Long, ByVal iOrigin As Integer) As Long

Declare Function OpenFile Lib "Kernel" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Integer) As Integer

'  OpenFile() Flags

Const OF_READ = &H0
Const OF_WRITE = &H1
Const OF_CREATE = &H1000

Declare Function GlobalAlloc Lib "Kernel" (ByVal wFlags As Integer, ByVal dwBytes As Long) As Integer
Declare Function GlobalFree Lib "Kernel" (ByVal hMem As Integer) As Integer
Declare Function GlobalLock Lib "Kernel" (ByVal hMem As Integer) As Long
Declare Function GlobalUnlock Lib "Kernel" (ByVal hMem As Integer) As Integer
Declare Function GlobalHandleToSel Lib "Toolhelp.dll" (ByVal hglb As Integer) As Integer
Declare Function MemoryRead Lib "Toolhelp.dll" (ByVal wSel As Integer, ByVal dwOffset As Long, lpvBuf As Any, ByVal dwcb As Long) As Long
Declare Function MemoryWrite Lib "Toolhelp.dll" (ByVal wSel As Integer, ByVal dwOffset As Long, lpvBuf As Any, ByVal dwcb As Long) As Long

Const GMEM_MOVEABLE = &H2
Const GMEM_ZEROINIT = &H40
Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)

Dim f_Of As OFSTRUCT        'Open file structure record
Dim f_File$                 'Name of file containing sample records
Dim f_NbrRecs As Long       'Number of records in sample file
Dim f_mHndl As Integer      'Memory handle to global memory
Dim f_Rec As f_RecType      'Sample record
Dim f_mSel%                 'Memory selector
Dim f_LenRec&               'Length of sample record

Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
Declare Function GetFocus% Lib "User" ()
Const WM_USER = &H400
Const LB_RESETCONTENT = (WM_USER + 5)

Sub Command0_Click ()

'Write a series of records to a disk file. We'll read this file
'into memory later.

  Open "Sample.dat" For Random As #1 Len = Len(f_Rec)
  For I& = 0 To 255
    f_Rec.I = I&
    f_Rec.L = I& * 2
    f_Rec.C = I& * 3
    f_Rec.S = I& / 10
    f_Rec.D = I& / 100
    f_Rec.ST = String$(30, I&)
    Put 1, , f_Rec
  Next I&
  Close #1
End Sub

Sub Command1_Click ()
  Call CreateHuge
End Sub

Sub Command2_Click ()
  Call FillListBox
End Sub

Sub Command3_Click ()
  For I& = 255 To 0 Step -1  'Write records to memory in reverse order
    f_Rec.I = I&
    f_Rec.L = I& * 2
    f_Rec.C = I& * 3
    f_Rec.S = I& / 10
    f_Rec.D = I& / 100
    f_Rec.ST = String$(30, I&)
    J& = 255& - I&
    rBytes& = MemoryWrite(f_mSel%, J& * f_LenRec&, f_Rec, f_LenRec&)
  Next I&
End Sub

Sub Command4_Click ()
  List1.SetFocus
  ret& = SendMessage(GetFocus(), LB_RESETCONTENT, 0, 0&)
End Sub

Sub Command5_Click ()
  Ok% = GlobalFree(f_mHndl)
End Sub

Sub Command6_Click ()
  End
End Sub

Sub CreateHuge ()
'--- creates huge array of records from sample file. The records are in a
'    type structure defined as "f_RecType".

  f_File$ = "Sample.dat"

  '--- open the data file for reading
  hFile = OpenFile(f_File$, f_Of, OF_READ)

  '--- get the size of the file
  size& = llseek(hFile, 0&, 2)

  '--- determine how many records are in the file
  f_NbrRecs = size& \ Len(f_Rec)

  '--- reset the file pointer to the start of the file
  rs& = llseek(hFile, 0&, 0)

  '--- create the global memory object
  f_mHndl = GlobalAlloc(GHND, size&)

  '--- make sure enough memory is available
  If f_mHndl = 0 Then
    Beep
    MsgBox "Insufficient memory to allocate array", 16, ""
    Exit Sub
  End If

  '--- get the address of the memory object
  lpAddr& = GlobalLock(f_mHndl)

  '--- read the data file into the memory object
  inBytes& = hread(hFile, ByVal lpAddr&, size&)

  '--- close the file
  cl = lclose(hFile)

  '--- unlock the memory object
  e = GlobalUnlock(f_mHndl)

End Sub

Sub FillListBox ()

'--- get the array memory object selector
'=================================================================
'    this only needs to be done once in any form or routine.
'    Note that memory is NOT locked. It doesn't need to be in
'    in protected mode so the selector is valid even if the memory
'    object gets moved.  As this routine requires the Win 3.1 API
'    calls, the app will always be running in protected mode.
'=================================================================

  f_mSel% = GlobalHandleToSel(f_mHndl)

  f_LenRec& = Len(f_Rec)

  '--- read records from array (f_NbrRecs is total # of records)
  For L& = 0 To f_NbrRecs - 1

    '--- read a record from array into f_Rec record structure
    rBytes& = MemoryRead(f_mSel%, L& * f_LenRec&, f_Rec, f_LenRec&)
    '--- add record to listbox
    T$ = Str$(f_Rec.I) + Str$(f_Rec.L) + Str$(f_Rec.C) + Str$(f_Rec.S) + Str$(f_Rec.D) + "  " + f_Rec.ST
    List1.AddItem T$
  Next L&
End Sub